home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / MAGICSYS.I < prev    next >
Text File  |  1991-06-08  |  7KB  |  273 lines
  1. (*#######################################################################
  2.  
  3.   MAGIC         Modula's  All purpose  GEM  Interface  Cadre
  4.                 ¯         ¯            ¯    ¯          ¯
  5. ########################################################################
  6.  
  7.   MAGICSYS      System-Spezialitäten
  8.                 Dieses Modul soll Inkompatibilitäten zwischen den einzel-
  9.                 nen Compilern aufheben.
  10.  
  11.                 WARNUNG:  Dieses Modul ist auf ABSOLUT UNTERSTER EBENE!!!
  12.  
  13.                 Implementation für Megamax-Modula-2
  14.  
  15. #########################################################################
  16.   V2.00  17.10.90  Peter Hellinger
  17.   V1.00  (c) by    Peter Hellinger
  18. #######################################################################*)
  19.  
  20. IMPLEMENTATION MODULE MagicSys;
  21.  
  22. (*----- MM2-Compilerswitches -----------*)
  23. (*                                      *)
  24. (*$R-   Range-Checks                    *)
  25. (*$S-   Stack-Check                     *)
  26. (*                                      *)
  27. (*--------------------------------------*)
  28.  
  29.  
  30. FROM SYSTEM IMPORT BYTE, WORD, ADDRESS, LONGWORD, ASSEMBLER;
  31. IMPORT SYSTEM, PrgCtrl;
  32.  
  33. VAR cast2:     RECORD
  34.                  CASE : CARDINAL OF
  35.                   0:  hi:   LOC;
  36.                       lo:   LOC;|
  37.                   1:  int:  sINTEGER;|
  38.                   2:  card: sCARDINAL;|
  39.                   3:  set:  sBITSET;|
  40.                   4:  wrd:  sWORD;|
  41.                  END;
  42.                 END;
  43.  
  44.  
  45. VAR cast4:     RECORD
  46.                  CASE : CARDINAL OF
  47.                   0:  b1:  LOC;
  48.                       b2:  LOC;
  49.                       b3:  LOC;
  50.                       b4:  LOC;|
  51.                   1:  int: lINTEGER;|
  52.                   2:  crd: lCARDINAL;|
  53.                   3:  set: lBITSET;|
  54.                   4:  wrd: lWORD;|
  55.                   5:  adr: ADDRESS;|
  56.                  END;
  57.                 END;
  58.  
  59.  
  60.  
  61. PROCEDURE CastToChar    (value: ARRAY OF LOC): CHAR;
  62. BEGIN
  63.  RETURN CHAR (value[HIGH (value)]);
  64. END CastToChar;
  65.  
  66.  
  67. PROCEDURE CastToByte    (value: ARRAY OF LOC): Byte;
  68. BEGIN
  69.  RETURN BYTE (value[HIGH (value)]);
  70. END CastToByte;
  71.  
  72.  
  73. PROCEDURE CastToByteset (value: ARRAY OF LOC): ByteSet;
  74. BEGIN
  75.  RETURN ByteSet (value[HIGH (value)]);
  76. END CastToByteset;
  77.  
  78.  
  79. PROCEDURE CastToInt     (value: ARRAY OF LOC): sINTEGER;
  80. BEGIN
  81.  IF HIGH (value) = 0 THEN
  82.   cast2.int:= 0;
  83.   cast2.lo:= value[0];
  84.  ELSE
  85.   cast2.hi:= value[HIGH (value)-1];
  86.   cast2.lo:= value[HIGH (value)];
  87.  END;
  88.  RETURN cast2.int;
  89. END CastToInt;
  90.  
  91.  
  92. PROCEDURE CastToCard    (value: ARRAY OF LOC): sCARDINAL;
  93. BEGIN
  94.  IF HIGH (value) = 0 THEN
  95.   cast2.card:= 0;
  96.   cast2.lo:= value[0];
  97.  ELSE
  98.   cast2.hi:= value[HIGH (value)-1];
  99.   cast2.lo:= value[HIGH (value)];
  100.  END;
  101.  RETURN cast2.card;
  102. END CastToCard;
  103.  
  104.  
  105. PROCEDURE CastToBitset  (value: ARRAY OF LOC): sBITSET;
  106. BEGIN
  107.  IF HIGH (value) = 0 THEN
  108.   cast2.set:= {};
  109.   cast2.lo:= value[0];
  110.  ELSE
  111.   cast2.hi:= value[HIGH (value)-1];
  112.   cast2.lo:= value[HIGH (value)];
  113.  END;
  114.  RETURN cast2.set;
  115. END CastToBitset;
  116.  
  117.  
  118. PROCEDURE CastToWord    (value: ARRAY OF LOC): sWORD;
  119. BEGIN
  120.  IF HIGH (value) = 0 THEN
  121.   cast2.int:= 0;
  122.   cast2.lo:= value[0];
  123.  ELSE
  124.   cast2.hi:= value[HIGH (value)-1];
  125.   cast2.lo:= value[HIGH (value)];
  126.  END;
  127.  RETURN cast2.wrd;
  128. END CastToWord;
  129.  
  130.  
  131. PROCEDURE CastToLInt    (value: ARRAY OF LOC): lINTEGER;
  132. BEGIN
  133.  CASE HIGH (value) OF
  134.   0:    cast4.int:= 0H;
  135.         cast4.b4:= value[0];
  136.         |
  137.   1:    cast4.int:= 0H;
  138.         cast4.b3:= value[HIGH (value)-1];
  139.         cast4.b4:= value[HIGH (value)];
  140.         |
  141.   ELSE  cast4.b1:= value[HIGH (value)-3];
  142.         cast4.b2:= value[HIGH (value)-2];
  143.         cast4.b3:= value[HIGH (value)-1];
  144.         cast4.b4:= value[HIGH (value)];
  145.  END;
  146.  RETURN cast4.int;
  147. END CastToLInt;
  148.  
  149.  
  150. PROCEDURE CastToLCard   (value: ARRAY OF LOC): lCARDINAL;
  151. BEGIN
  152.  CASE HIGH (value) OF
  153.   0:    cast4.crd:= 0H;
  154.         cast4.b4:= value[0];
  155.         |
  156.   1:    cast4.crd:= 0H;
  157.         cast4.b3:= value[HIGH (value)-1];
  158.         cast4.b4:= value[HIGH (value)];
  159.         |
  160.   ELSE  cast4.b1:= value[HIGH (value)-3];
  161.         cast4.b2:= value[HIGH (value)-2];
  162.         cast4.b3:= value[HIGH (value)-1];
  163.         cast4.b4:= value[HIGH (value)];
  164.  END;
  165.  RETURN cast4.crd;
  166. END CastToLCard;
  167.  
  168.  
  169. PROCEDURE CastToLBitset (value: ARRAY OF LOC): lBITSET;
  170. BEGIN
  171.  CASE HIGH (value) OF
  172.   0:    cast4.set:= lBITSET{};
  173.         cast4.b4:= value[0];
  174.         |
  175.   1:    cast4.set:= lBITSET{};
  176.         cast4.b3:= value[HIGH (value)-1];
  177.         cast4.b4:= value[HIGH (value)];
  178.         |
  179.   ELSE  cast4.b1:= value[HIGH (value)-3];
  180.         cast4.b2:= value[HIGH (value)-2];
  181.         cast4.b3:= value[HIGH (value)-1];
  182.         cast4.b4:= value[HIGH (value)];
  183.  END;
  184.  RETURN cast4.set;
  185. END CastToLBitset;
  186.  
  187.  
  188. PROCEDURE CastToLWord   (value: ARRAY OF LOC): lWORD;
  189. BEGIN
  190.  CASE HIGH (value) OF
  191.   0:    cast4.crd:= 0;
  192.         cast4.b4:= value[0];
  193.         |
  194.   1:    cast4.crd:= 0;
  195.         cast4.b3:= value[HIGH (value)-1];
  196.         cast4.b4:= value[HIGH (value)];
  197.         |
  198.   ELSE  cast4.b1:= value[HIGH (value)-3];
  199.         cast4.b2:= value[HIGH (value)-2];
  200.         cast4.b3:= value[HIGH (value)-1];
  201.         cast4.b4:= value[HIGH (value)];
  202.  END;
  203.  RETURN cast4.wrd;
  204. END CastToLWord;
  205.  
  206.  
  207. PROCEDURE CastToAddr    (value: ARRAY OF LOC): ADDRESS;
  208. BEGIN
  209.  CASE HIGH (value) OF
  210.   0:    cast4.crd:= 0H;
  211.         cast4.b4:= value[0];
  212.         |
  213.   1:    cast4.crd:= 0H;
  214.         cast4.b3:= value[HIGH (value)-1];
  215.         cast4.b4:= value[HIGH (value)];
  216.         |
  217.   ELSE  cast4.b1:= value[HIGH (value)-3];
  218.         cast4.b2:= value[HIGH (value)-2];
  219.         cast4.b3:= value[HIGH (value)-1];
  220.         cast4.b4:= value[HIGH (value)];
  221.  END;
  222.  RETURN cast4.adr;
  223. END CastToAddr;
  224.  
  225.  
  226. PROCEDURE Basepage (): ADDRESS;
  227. VAR adr: ADDRESS;
  228. BEGIN
  229.  PrgCtrl.GetBasePageAddr (adr);
  230.  RETURN adr;
  231. END Basepage;
  232.  
  233.  
  234. PROCEDURE Terminate (return: sINTEGER);
  235. BEGIN
  236.  PrgCtrl.TermProcess (return);
  237. END Terminate;
  238.  
  239.  
  240. PROCEDURE CallGEM (function: sINTEGER; parablock: ADDRESS);
  241. BEGIN
  242.  ASSEMBLER
  243.   MOVE.W  function(A6), D0
  244.   MOVE.L  parablock(A6), D1
  245.   TRAP    #2
  246.  END;
  247. END CallGEM;
  248.  
  249.  
  250. PROCEDURE VqGdos (): BOOLEAN;
  251. VAR x: LONGINT;
  252. BEGIN
  253.  ASSEMBLER
  254.   MOVE.L  #-2, D0
  255.   TRAP    #2
  256.   MOVE.L  D0, x(A6)
  257.  END;
  258.  RETURN x # -2L;
  259. END VqGdos;
  260.  
  261.  
  262. PROCEDURE CatchD0 (): LONGCARD;
  263. VAR x: LONGCARD;
  264. BEGIN
  265.  ASSEMBLER
  266.   MOVE.L  D0, x(A6)
  267.  END;
  268.  RETURN x;
  269. END CatchD0;
  270.  
  271.  
  272. END MagicSys.
  273.